home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Development / General / ViewIt™ 2.24 Shareware / Pascal Demo Projects / THINK Pascal 4.0 Demos / fDemoLP.pas < prev    next >
Pascal/Delphi Source File  |  1993-09-20  |  3KB  |  145 lines
  1. {FaceIt 2.2 Demonstration Program}
  2. {©FaceWare 1989-93.  All Rights Reserved.}
  3. {C1 - run program to see on-line comments}
  4. program fDemoLP;
  5. {$I-}
  6.  
  7. {C2}
  8.     uses
  9.         FaceStorLP, FaceProcLP;
  10.     var
  11.         i, mode: integer;
  12.         oldCount, newCount: longint;
  13.         keys: KeyMap;
  14.         fileName: Str255;
  15.  
  16. begin
  17.     with fRec do
  18.         begin
  19. {C3}
  20.             uName := 'fDemo.Rsrc';
  21. {C4}
  22.             FaceIt(nil, DoInit, 3, 0, 0, 0);
  23. {C5}
  24.             FaceIt(nil, NewWnd, 1010, 1, 0, 0);
  25.             FaceIt(nil, NewWnd, 1020, 1, 0, 0);
  26. {C6}
  27.             FaceIt(nil, NewWnd, 1030, 1, 0, 0);
  28. {C7}
  29.             FaceIt(nil, NewWnd, 1040, 2, 0, 0);
  30. {C8}
  31.             repeat
  32.                 FaceIt(nil, DoLoop, 0, 0, 0, 0);
  33. {C9}
  34.                 case uMenuID of
  35. {C10}
  36.                     101: 
  37.                         if (uMenuItem = 1) then
  38.                             begin
  39.                                 uString := concat('Demonstration of the use of FaceIt', chr(13), 'to support program-wide features.');
  40.                                 FaceIt(nil, ShoStr, 3, 12, 1 + (409 * 65536), 0);
  41.                             end;
  42. {C11}
  43.                     102: 
  44.                         if (uMenuItem = 6) then
  45.                             begin
  46.                                 FaceIt(nil, GetWVC, 1010, 0, 0, 0);
  47.                                 FaceIt(nil, SavWnd, 1010, 0, 0, 0);
  48.                                 FaceIt(nil, GetWVC, 1020, 0, 0, 0);
  49.                                 FaceIt(nil, SavWnd, 1020, 0, 0, 0);
  50.                                 FaceIt(nil, GetWVC, 1040, 0, 0, 0);
  51.                                 FaceIt(nil, SavWnd, 1040, 0, 0, 0);
  52.                             end;
  53. {C12}
  54.                     105, 106, 1030, 1040: 
  55.                         case uMenuItem of
  56.                             1: 
  57.                                 SysBeep(5);
  58.                             2: 
  59.                                 begin
  60.                                     SysBeep(5);
  61.                                     SysBeep(5);
  62.                                 end;
  63.                             3: 
  64.                                 begin
  65.                                     SysBeep(5);
  66.                                     SysBeep(5);
  67.                                     SysBeep(5);
  68.                                 end;
  69. {C13}
  70.                             4: 
  71.                                 begin
  72.                                     FaceIt(nil, GetCtl, 1030, 0, 1, 4);
  73.                                     FaceIt(nil, PopMen, 107, cRect.top - 9, cRect.left - 10, 0);
  74.                                 end;
  75. {C14}
  76.                             8: 
  77.                                 begin
  78. {C15}
  79.                                     FaceIt(nil, ShoAlt, 1010, 0, 1, 1);
  80.                                     mode := uResult;
  81.                                     oldCount := 0;
  82.                                     if (mode > 1) then
  83.                                         while true do
  84.                                             begin
  85. {C16}
  86.                                                 newCount := TickCount;
  87.                                                 if (newCount - oldCount > 180) then
  88.                                                     begin
  89.                                                         SysBeep(5);
  90.                                                         oldCount := newCount;
  91.                                                     end;
  92. {C17}
  93.                                                 if (mode = 2) then
  94.                                                     if GetNextEvent(-1, fEvent) then
  95.                                                         if (fEvent.what = 5) then
  96.                                                             leave
  97.                                                         else
  98.                                                             FaceIt(nil, DoEvnt, 0, 0, 0, 0);
  99. {C18}
  100.                                                 if (mode = 3) then
  101.                                                     begin
  102.                                                         GetKeys(keys);
  103.                                                         if BitTst(@keys, 61) and BitTst(@keys, 48) then
  104.                                                             begin
  105.                                                                 FlushEvents(62, 0);
  106.                                                                 leave;
  107.                                                             end;
  108.                                                     end;
  109.                                             end;
  110.                                 end;
  111.                             otherwise
  112.                         end;
  113. {C19}
  114.                     1100: 
  115.                         if (uMenuItem = 2) then
  116.                             begin
  117.                                 if (fActiveWnd = nil) then
  118.                                     uString := 'No Window'
  119.                                 else if (fActiveID <> 1200) then
  120.                                     uString := 'Non-ViewIt Window'
  121.                                 else if (fActiveResID = 1204) then
  122.                                     uString := 'Help Window'
  123.                                 else if (fActiveResID = 1010) then
  124.                                     uString := 'Editor Window'
  125.                                 else if (fActiveResID = 1020) then
  126.                                     uString := 'Clipboard Window'
  127.                                 else if (fActiveResID = 1030) then
  128.                                     uString := 'Beeps Window';
  129.                                 FaceIt(nil, SetItm2, 105, 10, 3, 0);
  130.                             end
  131. {C20}
  132.                         else if (uMenuItem = 512) then
  133.                             if (uString = 'TEXT') and (uResult = 1) then
  134.                                 begin
  135.                                     fileName := uName;
  136.                                     FaceIt(nil, GetCtl, 1010, 0, 1, 1);
  137.                                     uName := fileName;
  138.                                     FaceIt(cControl, 1551, 0, 1, 0, 0);    {OpnCTxt}
  139.                                 end;
  140.                     otherwise
  141.                 end;
  142.             until false;
  143.  
  144.         end;
  145. end.